home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Graphics Plus
/
Graphics Plus.iso
/
msdos
/
plotting
/
rcdsplay
/
math.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-10
|
9KB
|
230 lines
UNIT MATH;
{*******************************************************************************
AUTHOR : Roger Carlson
VERSION : 1.3
UPDATES : 3/28/91 (1.1,RJC) - Added the 95% students T function.
5/3/91 (1.2,RJC) - Added wavelength/wavenumber conversions.
5/10/91 (1.3,RJC) - Added HEX function.
*******************************************************************************}
INTERFACE
FUNCTION T(DF:INTEGER):DOUBLE;
FUNCTION LOG(INP : REAL) : REAL;
FUNCTION PWROF2(X:longint):LONGINT;
FUNCTION PWROFTWO(X : INTEGER) : INTEGER;
FUNCTION PWROF10(NUMBER:LONGINT):DOUBLE;
FUNCTION ARCCOS(COSTHETA:DOUBLE):DOUBLE;
FUNCTION ARCSIN(SINTHETA:DOUBLE):DOUBLE;
FUNCTION TAN(THETA:DOUBLE):DOUBLE;
FUNCTION COTAN(THETA:DOUBLE):DOUBLE;
FUNCTION A_TO_CM(WAVELENGTH:DOUBLE):DOUBLE;
FUNCTION CM_TO_A(WAVENUMBER:DOUBLE):DOUBLE;
FUNCTION HEX(B:BYTE):STRING;
IMPLEMENTATION
{***************************************************************************
TITLE : FUNCTION HEX(B:BYTE):STRING;
AUTHOR : Roger Carlson (May 1991)
FUNCTION: Converts a binary byte to hexidecimal format.
INPUTS : B - Byte in binary.
OUTPUTS : String containing hex representation of B.
****************************************************************************}
FUNCTION HEX;
VAR B1,B2:BYTE; C1,C2:CHAR;
BEGIN
B1:=B AND $F; B2:=(B AND $F0) SHR 4;
IF B1>9 THEN C1:=CHAR(55+B1) ELSE C1:=CHAR(48+B1);
IF B2>9 THEN C2:=CHAR(55+B2) ELSE C2:=CHAR(48+B2);
HEX:=CONCAT(C2,C1);
END;
{*******************************************************************************
TITLE : FUNCTION T(DF:INTEGER):DOUBLE;
AUTHOR : Roger Carlson (August 1986)
FUNCTION: This function returns the 95% double sided Student's t.
INPUTS : DF - degrees of freedom
NOTES : 1. DF must be at least 1.
*******************************************************************************}
FUNCTION T; BEGIN
CASE DF OF
1: T:=12.706; 2: T:=4.303; 3: T:=3.182; 4: T:=2.776; 5: T:=2.571;
6: T:=2.447; 7: T:=2.365; 8: T:=2.306; 9: T:=2.262; 10:T:=2.228;
11:T:=2.201; 12:T:=2.179; 13:T:=2.160; 14:T:=2.145; 15:T:=2.131;
16:T:=2.120; 17:T:=2.110; 18:T:=2.101; 19:T:=2.093; 20:T:=2.086;
21:T:=2.080; 22:T:=2.074; 23:T:=2.069; 24:T:=2.064; 25:T:=2.060;
26:T:=2.056; 27:T:=2.052; 28:T:=2.048; 29:T:=2.045;
ELSE T:=1.960;
END; {CASE}
END; {FUNCTION T}
{******************************************************************************
TITLE: LOG(INP : REAL) : REAL;
VERSION: 1.0
FUNCTION: Takes base 10 logarithm of a number.
INPUTS: A real number.
OUTPUTS: The log of the input real number.
NOTES: Why doesn't standard PASCAL have this???
AUTHOR: M. Riebe 5/2/85
CHANGES:
******************************************************************************}
FUNCTION LOG; BEGIN
LOG := LN(INP)/2.3025851;
END;
{******************************************************************************
TITLE : FUNCTION PWROF2(X:longint):LONGINT;
AUTHOR : Roger Carlson 3/14/87
FUNCTION: This function returns 2 raised to the power x.
INPUTS : X - Exponent of 2 (a positive number).
OUTPUTS : 2**X
NOTES : 1. The maximum LONGINT is 2147483647=$7FFFFFFF or x=31.
CHANGES :
*******************************************************************************}
FUNCTION PWROF2; BEGIN
X:=ABS(X);
CASE X OF
0:PWROF2:=1; 1:PWROF2:=2; 2:PWROF2:=4; 3:PWROF2:=8;
4:PWROF2:=16; 5:PWROF2:=32; 6:PWROF2:=64; 7:PWROF2:=128;
8:PWROF2:=256; 9:PWROF2:=512; 10:PWROF2:=1024; 11:PWROF2:=2048;
ELSE PWROF2:=2*PWROF2(X-1);
END; {CASE}
END; {FUNCTION PWROF2}
{******************************************************************************
TITLE: PWROFTWO(X : INTEGER) : INTEGER;
VERSION: 1.0
FUNCTION: Takes 2 to the X power.
INPUTS: X, an integer value.
OUTPUTS: 2 to the X power, also an integer.
NOTES:
AUTHOR: Adapted for integer output from R. Carlson's by M. Riebe, 6/23/85
CHANGES:
******************************************************************************}
FUNCTION PWROFTWO;BEGIN
IF X=0 THEN PWROFTWO := 1 ELSE PWROFTWO := 2 * PWROFTWO(X-1);
END;
{******************************************************************************
TITLE: PWROF10(NUMBER:LONGINT): DOUBLE
VERSION: 1.1
FUNCTION: Calculates integral powers of ten to double precision.
NOTES:
AUTHOR: RJC 9/25/85
CHANGES: (4/8/90, 1.1, RJC) Modified to use a look up table for small
values of NUMBER.
(5/31/90, 1.2, RJC) Fixed error in look-up table.
******************************************************************************}
FUNCTION PWROF10; BEGIN
IF NUMBER<0 THEN PWROF10:=1/PWROF10(ABS(NUMBER))
ELSE CASE NUMBER OF
0: PWROF10:=1; 1: PWROF10:=10; 2: PWROF10:=1E2;
3: PWROF10:=1E3; 4: PWROF10:=1E4; 5: PWROF10:=1E5;
6: PWROF10:=1E6; 7: PWROF10:=1E7; 8: PWROF10:=1E8;
9: PWROF10:=1E9; 10: PWROF10:=1E10; 11: PWROF10:=1E11;
ELSE PWROF10:=10E0*PWROF10(NUMBER-1);
END {CASE}
END;
{*****************************************************************************
TITLE : FUNCTION ARCCOS(COSTHETA:DOUBLE):DOUBLE;
VERSION : 1.0
AUTHOR : RJC 11/21/85
FUNCTION : Calculates the inverse cosine of COSTHETA in radians.
CHANGES :
****************************************************************************}
FUNCTION ARCCOS; BEGIN
IF ABS(COSTHETA)>1E0 THEN BEGIN
ARCCOS:=0;
WRITELN('Error in ARCCOS function of MATH! Arguement out of range.');
END {IF}
ELSE ARCCOS:=ARCTAN(SQRT(1E0/SQR(COSTHETA)-1E0));
END; {FUNCTION ARCCOS}
{*******************************************************************************
TITLE : FUNCTION ARCSIN(SINTHETA:DOUBLE):DOUBLE;
VERSION : 1.0
AUTHOR : RJC 11/21/85
FUNCTION : Calculates the inverse sine of SINTHETA in radians.
CHANGES :
*******************************************************************************}
FUNCTION ARCSIN;
VAR THETA:DOUBLE;
BEGIN
IF ABS(SINTHETA)>1E0 THEN BEGIN
ARCSIN:=0;
WRITELN('Error in ARCSIN function of MATH! Arguement out of range.');
END {IF}
ELSE THETA:=ARCTAN(SQRT(1E0/(1E0/SQR(SINTHETA)-1E0)));
IF SINTHETA<0 THEN ARCSIN:=-THETA
ELSE ARCSIN:=THETA;
END; {FUNCTION ARCSIN}
{*******************************************************************************
TITLE : FUNCTION TAN(THETA:DOUBLE):DOUBLE;
VERSION : 1.0
AUTHOR : RJC 11/21/85
FUNCTION : Calculates the tangent of THETA where THETA is in radians.
CHANGES :
*******************************************************************************}
FUNCTION TAN; BEGIN
TAN:=SIN(THETA)/COS(THETA);
END; {FUNCTION TAN}
{*******************************************************************************
TITLE : FUNCTION COTAN(THETA:DOUBLE):DOUBLE;
VERSION : 1.0
AUTHOR : RJC 11/21/85
FUNCTION : Calculates the cotangent of THETA where THETA is in radians.
CHANGES :
*******************************************************************************}
FUNCTION COTAN; BEGIN
COTAN:=COS(THETA)/SIN(THETA);
END; {FUNCTION COTAN}
{*************************************************************************
TITLE: REF_IND(WAVENUM:DOUBLE):DOUBLE
VERSION: 1.0 (Roger Carlson, 5/3/91)
FUNCTION: Calculates refractive index of air according to Eblens formula.
INPUT: Vacuum wavenumber.
OUTPUT: Refractive index in air.
**************************************************************************}
FUNCTION REF_IND(WAVENUM:DOUBLE):DOUBLE;
CONST A=6432.8E-8; B=2.949810E6; C=1.46E10; D=2.5540E4; E=4.1E9;
BEGIN
REF_IND:=1.0E0 + A + B/(C-SQR(WAVENUM)) + D/(E-SQR(WAVENUM));
END;
{**************************************************************************
TITLE : CM_TO_A(WAVENUMBER:DOUBLE):DOUBLE
VERSION : 1.0
FUNCTION : Converts wavenumbers to wavelength.
INPUTS : Vacuum wavenumber in cm-1.
OUTPUTS : Air wavelength in Angstroms.
***************************************************************************}
FUNCTION CM_TO_A; BEGIN
CM_TO_A:=1.0E8/WAVENUMBER/REF_IND(WAVENUMBER);
END;
{**************************************************************************
TITLE : A_TO_CM(WAVELENGTH:DOUBLE):DOUBLE;
VERSION : 1.0
FUNCTION : Converts wavelength in Angstroms in air to vacuum wavenumbers.
INPUTS : Wavelength in Angstroms (air).
OUTPUTS : Wavenumber in cm-1 (vacuum).
***************************************************************************}
FUNCTION A_TO_CM;
CONST LIMIT=1.0E-5; {level of precision in Angstroms}
VAR CM:DOUBLE;
BEGIN
CM:=1.0E8/WAVELENGTH;
REPEAT
CM:=1.0E8/WAVELENGTH/REF_IND(CM);
UNTIL ABS(CM_TO_A(CM)-WAVELENGTH)<LIMIT;
A_TO_CM:=CM;
END; {FUNCTION A_TO_CM}
END. {UNIT}